home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / lineco1a / form1.frm next >
Text File  |  1999-09-30  |  4KB  |  134 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.Form Form1 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Line Count Example"
  6.    ClientHeight    =   4740
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   5085
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4740
  14.    ScaleWidth      =   5085
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.Timer Timer1 
  17.       Interval        =   25
  18.       Left            =   1680
  19.       Top             =   4200
  20.    End
  21.    Begin VB.PictureBox picLines 
  22.       AutoRedraw      =   -1  'True
  23.       BorderStyle     =   0  'None
  24.       BeginProperty Font 
  25.          Name            =   "MS Serif"
  26.          Size            =   6.75
  27.          Charset         =   0
  28.          Weight          =   400
  29.          Underline       =   0   'False
  30.          Italic          =   0   'False
  31.          Strikethrough   =   0   'False
  32.       EndProperty
  33.       Height          =   4740
  34.       Left            =   0
  35.       ScaleHeight     =   4740
  36.       ScaleWidth      =   495
  37.       TabIndex        =   1
  38.       TabStop         =   0   'False
  39.       Top             =   0
  40.       Width           =   495
  41.    End
  42.    Begin RichTextLib.RichTextBox RichTextBox1 
  43.       Height          =   4695
  44.       Left            =   480
  45.       TabIndex        =   0
  46.       Top             =   0
  47.       Width           =   4575
  48.       _ExtentX        =   8070
  49.       _ExtentY        =   8281
  50.       _Version        =   393217
  51.       Enabled         =   -1  'True
  52.       ScrollBars      =   3
  53.       TextRTF         =   $"Form1.frx":0000
  54.    End
  55. End
  56. Attribute VB_Name = "Form1"
  57. Attribute VB_GlobalNameSpace = False
  58. Attribute VB_Creatable = False
  59. Attribute VB_PredeclaredId = True
  60. Attribute VB_Exposed = False
  61. 'This Code was Created By Bryan Cairns
  62. 'Also this code is FREE so please do with it as you see fit
  63. '
  64. 'The procedure is really simple, just use a timer control to call
  65. 'the Drawlines Sub which counts the current lines in a Rich text box
  66. 'and finds the 1st visible line, and the current line
  67. 'then it uses the print function to display the line numbers.
  68. 'Also to speed things up, the Drawlines Sub is called when the user
  69. 'interacts with the Rich text Box.
  70. 'have fun :) Bryan Cairns
  71. 'http://www.html-helper.com
  72. 'cairnsb@html-helper.com
  73.  
  74. Option Explicit
  75.  
  76. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  77. Private Const EM_GETLINECOUNT = &HBA
  78. Private Const EM_LINEINDEX = &HBB
  79. Private Const EM_LINELENGTH = &HC1
  80. Private Const EM_GETFIRSTVISIBLELINE = &HCE
  81.  
  82. Private Sub DrawLines(picTo As PictureBox, RTF As RichTextBox)
  83. Dim iLine As Long, cLine As Long, vLine As Long
  84. 'count the lines
  85. iLine = SendMessage(RTF.hwnd, EM_GETLINECOUNT, ByVal 0&, ByVal 0&)
  86. 'current line
  87. cLine = 1 + RTF.GetLineFromChar(RTF.SelStart)
  88. 'first visible line
  89. vLine = SendMessage(RTF.hwnd, EM_GETFIRSTVISIBLELINE, ByVal 0&, ByVal 0&)
  90. picTo.Cls
  91.  
  92. picTo.Font = RTF.Font
  93. picTo.ForeColor = &H8000000C
  94. Dim I As Integer
  95. For I = vLine + 1 To iLine
  96. If I <> cLine Then
  97. picTo.ForeColor = &H8000000C
  98. picTo.Print I
  99. Else
  100. If I = cLine Then
  101. picTo.ForeColor = &H80000018
  102. picTo.Print I
  103. End If
  104. End If
  105. Next I
  106. End Sub
  107.  
  108. Private Sub Form_Load()
  109. RichTextBox1.SelText = RichTextBox1.SelText & "This is an example of how to display" & vbCrLf
  110. RichTextBox1.SelText = RichTextBox1.SelText & "the line count and current line in a Rich Text Box." & vbCrLf
  111. RichTextBox1.SelText = RichTextBox1.SelText & vbCrLf
  112. RichTextBox1.SelText = RichTextBox1.SelText & "cairnsb@html-helper.com"
  113. RichTextBox1.SelStart = 0
  114. picLines.Top = RichTextBox1.Top + 50
  115. picLines.Height = RichTextBox1.Height
  116. DrawLines picLines, RichTextBox1
  117. End Sub
  118.  
  119. Private Sub RichTextBox1_Change()
  120. DrawLines picLines, RichTextBox1
  121. End Sub
  122.  
  123. Private Sub RichTextBox1_KeyPress(KeyAscii As Integer)
  124. DrawLines picLines, RichTextBox1
  125. End Sub
  126.  
  127. Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  128. DrawLines picLines, RichTextBox1
  129. End Sub
  130.  
  131. Private Sub Timer1_Timer()
  132. DrawLines picLines, RichTextBox1
  133. End Sub
  134.